BBS in a Box 5/BBS in a Box -Volume V (BBS in a Box) (April 1992).iso/Files/Prog/M/MacOberon.cpt/MacOberon122.sit/TickCounter.Mod

Oberon Text | 1990-10-18 | 4.1 KB | 102 lines | [.Ob./.Ob*]

Syntax10.Scn.Fnt
MODULE TickCounter;    (* Michael Franz, 6.9.90 *)
        Installs a Task that will update a tick count which is displayed centered
        in a viewer.  Oberon Tasks even run in the background under MultiFinder
        but are activated less often.
            The tick count may be exported to the caret position by the usual
        CopyOver control-option combination.
            Great for demo purposes - the larger the font chosen, the better the
        effect.
        Position the Star Marker in this viewer (Enter on Keypad)
                Compiler.Compile *
                TickCounter.Open
    IMPORT
        SYSTEM, Display, Fonts, Oberon, Texts, TextFrames, Viewers, MenuViewers, Input;
    TYPE
        TickMsg = RECORD (Display.FrameMsg)    END;
        Frame = POINTER TO FrameDesc;
        FrameDesc = RECORD (Display.FrameDesc) END;
        W: Texts.Writer;
        ticks: LONGINT; countTask: Oberon.Task;
        x, y: ARRAY 10 OF INTEGER; pat: ARRAY 10 OF LONGINT; dx0, fontH : INTEGER;
    PROCEDURE* Tick;    (* Installed as an Oberon Task *)
        VAR t: LONGINT; M: TickMsg;
    BEGIN    SYSTEM.GET(16AH, t);
        IF    t # ticks    THEN    ticks := t; Viewers.Broadcast(M)    END
    END Tick;
    PROCEDURE UpdateCounter(F: Frame);    (* Update Tick Count in Frame F *)
        VAR i: INTEGER; n: LONGINT; a: ARRAY 10 OF INTEGER; ch, X, Y, LX, NX, W: INTEGER;
    BEGIN
        IF    F.H > fontH    THEN    i := 0; n := ticks;
            REPEAT    a[i] := SHORT(n MOD 10); n := n DIV 10; INC(i)    UNTIL    n=0;
            LX := (F.W - i*dx0) DIV 2; NX := F.X + F.W; W := F.W-2*LX; X := F.X + LX; Y := F.Y + (F.H - fontH) DIV 2;
            Display.OpenCache(X, Y, W, fontH);
            REPEAT    DEC(i); ch := a[i]; Display.AccumulatePat(pat[ch], X + x[ch], Y + y[ch]); INC(X, dx0)    UNTIL    i=0;
            Display.TransferCache(Display.replace)
        END
    END UpdateCounter;
    PROCEDURE Export;    (* Copy Counter to Caret *)
        VAR M: Oberon.CopyOverMsg;
    BEGIN    Texts.WriteInt(W, ticks, 8); M.text := TextFrames.Text(""); Texts.Append(M.text, W.buf);
        M.beg := 0; M.end := M.text.len; Oberon.FocusViewer.handle(Oberon.FocusViewer, M)
    END Export;
    PROCEDURE Handle*(F: Display.Frame; VAR M: Display.FrameMsg);
        VAR keysum: SET; F1: Frame;
    BEGIN
        WITH    F: Frame    DO
            IF    M IS TickMsg    THEN    UpdateCounter(F)
            ELSIF    M IS Oberon.InputMsg    THEN
                WITH    M: Oberon.InputMsg    DO
                    IF    M.id = Oberon.track    THEN
                        IF    (M.X >= F.X) & (M.X < F.X + F.W) & (F.Y <= M.Y)    THEN    keysum := M.keys;
                            Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, M.X, M.Y);
                            WHILE    M.keys # {}    DO    Input.Mouse(M.keys, M.X, M.Y); keysum := keysum + M.keys;
                                Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, M.X, M.Y)
                            END;
                            IF    keysum = {0, 1}    THEN    Export    END
                        END
                    END
                END
            ELSIF    M IS Oberon.ControlMsg    THEN
                WITH    M: Oberon.ControlMsg    DO
                    IF    M.id = Oberon.mark    THEN    Oberon.DrawCursor(Oberon.Pointer, Oberon.Star, M.X, M.Y)    END
                END
            ELSIF    M IS Oberon.CopyMsg    THEN
                WITH    M: Oberon.CopyMsg    DO    NEW(F1); F1^ := F^; M.F := F1    END
            ELSIF    M IS MenuViewers.ModifyMsg    THEN
                WITH    M: MenuViewers.ModifyMsg    DO    F.H := M.H; F.Y := M.Y;
                    IF    M.H > 0    THEN    Display.ReplConst(Display.black, F.X, F.Y, F.W, F.H, Display.replace); UpdateCounter(F)    END
                END
            END
        END
    END Handle;
    PROCEDURE NewCountFrame(): Frame;
        VAR F: Frame;
    BEGIN    NEW(F); F.handle := Handle; RETURN F
    END NewCountFrame;
    PROCEDURE NewCountTask(VAR T: Oberon.Task);
    BEGIN    NEW(T); T.safe := FALSE; T.handle := Tick; Oberon.Install(T)
    END NewCountTask;
    PROCEDURE Open*;
        VAR X, Y: INTEGER; V: Viewers.Viewer;
    BEGIN
        IF    countTask = NIL    THEN    NewCountTask(countTask)    END;
        Oberon.AllocateSystemViewer(Oberon.SystemTrack(0), X, Y);
        V := MenuViewers.New(
            TextFrames.NewMenu("TickCounter", "System.Close System.Copy System.Grow TickCounter.Stop"),
            NewCountFrame(),
            TextFrames.menuH, X, Y)
    END Open;
    PROCEDURE Stop*;
    BEGIN    Oberon.Remove(countTask); countTask := NIL
    END Stop;
    PROCEDURE InitTable;
        VAR fnt: Fonts.Font; i, w, h, dx: INTEGER;
    BEGIN    fnt:= Fonts.This("Syntax20.Scn.Fnt"); i := 9;
        WHILE    i >= 0    DO    Display.GetChar(fnt.raster, CHR(ORD("0")+ i), dx, x[i], y[i], w, h, pat[i]); DEC(i)    END;
        dx0 := dx; fontH := fnt.height
    END InitTable;
BEGIN
    Texts.OpenWriter(W); InitTable; NewCountTask(countTask)
END TickCounter.